Assassins - Ultimate CD Games Collection 3/Assassins 3 - The Ultimate Games CD (1997)(Weird Science)[!][Amiga-CD32-CDTV].iso/arcade/tetris_3.1/tetris.amos/tetris.amosSourceCode

AMOS Source Code | 1977-12-31 | 17KB | 866 lines

Rem Tetris v1.2
Key Speed 4,4
Dim SCORE(9)
Dim NOME$(9)
Dim A(11,21)
Dim STATISTICA(7)
Global ABBASSO,VECC,DF,_TOCCATO,PRESENTE
Global RUOTATE,VELOCITA,A(),PROSSIMO,LINEE,PUNTI,STATISTICA()
Global _MUSICA,ARCOBALENO,HIGH
HIGH=0 : _MUSICA=1 : ARCOBALENO=1
INIZIO:
Hide On
PRESENTAZIONE
If _MUSICA=1 Then Music 1
SEB[0,2,16,0]
Unpack 6 To 0
Ink 2
If ARCOBALENO=1
   ARCOBALENO[200]
   Shift Up 14,26,27,1
Else
   Rainbow Del
End If
Ink 2,0
RESET
If HIGH>0
   Proc ALTEZZA
End If
PROSSIMO
Timer=0
VECC=0
PUNTI[1,1]
Do
   Clear Key
   ABBASSO=0
   METTI
   A:
   If Key State(69) Then Goto FINE
   If Key Shift=4
      PAUSE
   End If
   X$=Inkey$
   HJ=Asc(X$)
   If HJ=30 and ABBASSO=0
      If VECC=0
         VECC=1
         _GIRA
      End If
   End If
   If Key State(76)=False
      VECC=0
   End If
   If HJ=28 and ABBASSO=0
      _DESTRA
   End If
   If HJ=29 and ABBASSO=0
      _SINISTRA
   End If
   If HJ=31 Then ABBASSO=1
   If ABBASSO=1
      Inc PUNTI
      PUNTI[1,0]
      _GIU
   End If
   If Timer<VELOCITA Then Goto A
   Timer=0
   _GIU
   If _TOCCATO=0 Then Goto A
   Sam Play 14
   For S=1 To 2
      For T=1 To 10
         If A(T,S)=1 Then Goto FINE
      Next
   Next
   MOV=0
   For T=1 To 10
      For S=1 To 20
         If A(T,S)=1
            Inc MOV
            A(T,S)=2
            If MOV=4
               Goto FISSA
            End If
         End If
      Next
   Next
   FISSA:
   Put Bob 2
   CANCELLA
Loop
'
'
Procedure RESET
   For T=1 To 10
      For S=1 To 20
         A(T,S)=0
      Next
   Next
   For T=1 To 10
      A(T,21)=5
   Next
   For T=1 To 20
      A(0,T)=5 : A(11,T)=5
   Next
   PROSSIMO=0
   PUNTI=0
   LINEE=0
   VELOCITA=16
End Proc
Procedure PUNTI[R,S]
   Ink 2,0
   If R=1 Then Text 190,140,Str$(PUNTI)
   If S=1 Then Text 190,190,Str$(LINEE)
   If LINEE=0 Then Pop Proc
   DELTA=16-(LINEE/15)
   If VELOCITA<>DELTA
      VELOCITA=DELTA
      Sam Play 2
   End If
   If VELOCITA<5 Then VELOCITA=4
End Proc
Procedure PROSSIMO
   Ink 27
   Bar 187,39 To 242,80
   K=Rnd(6)+1
   If K<6
      PROSSIMO=K*2-1
   Else
      If K=6
         PROSSIMO=13
      End If
      If K=7
         PROSSIMO=17
      End If
   End If
   If PROSSIMO=1
      Paste Bob 209,39,1
   End If
   If PROSSIMO=3
      Paste Bob 204,50,3
   End If
   If PROSSIMO=5 or PROSSIMO=7
      Paste Bob 200,50,PROSSIMO
   End If
   If PROSSIMO=9
      Paste Bob 198,47,9
   End If
   If PROSSIMO=13
      Paste Bob 200,44,13
   End If
   If PROSSIMO=17
      Paste Bob 198,48,17
   End If
End Proc
Procedure METTI
   RUOTATE=0
   PRESENTE=PROSSIMO
   PROSSIMO
   Bob 2,69,24,PRESENTE
   If PRESENTE=1
      STAT=1 : Ink 2
      A(5,1)=1
      A(5,2)=1
      A(5,3)=1
      A(5,4)=1
   End If
   If PRESENTE=3
      STAT=2 : Ink 8
      A(5,1)=1
      A(5,2)=1
      A(6,1)=1
      A(6,2)=1
   End If
   If PRESENTE=5
      STAT=3 : Ink 10
      A(5,1)=1
      A(6,1)=1
      A(6,2)=1
      A(7,2)=1
   End If
   If PRESENTE=7
      STAT=4 : Ink 5
      A(6,1)=1
      A(7,1)=1
      A(6,2)=1
      A(5,2)=1
   End If
   If PRESENTE=9
      STAT=5 : Ink 14
      A(5,2)=1
      A(6,2)=1
      A(7,2)=1
      A(7,1)=1
   End If
   If PRESENTE=13
      STAT=6 : Ink 4
      A(6,1)=1
      A(6,2)=1
      A(6,3)=1
      A(5,3)=1
   End If
   If PRESENTE=17
      STAT=7 : Ink 28
      A(5,1)=1
      A(6,1)=1
      A(7,1)=1
      A(6,2)=1
   End If
   STATISTICA[STAT]
End Proc
Procedure _SINISTRA
   LIBERO=0
   MOV=0
   For T=1 To 10
      For S=1 To 20
         If A(T,S)=1
            Inc MOV
            If A(T-1,S)>1
               LIBERO=1
            End If
            If MOV=4
               Goto B
            End If
         End If
      Next
   Next
   B:
   If LIBERO=1 Then Pop Proc
   MOV=0
   For T=1 To 10
      For S=1 To 20
         If A(T,S)=1
            A(T,S)=0
            A(T-1,S)=1
            Inc MOV
            If MOV=4
               Goto A
            End If
         End If
      Next
   Next
   A:
   Bob 2,X Bob(2)-10,,
End Proc
Procedure _DESTRA
   LIBERO=0
   MOV=0
   For T=1 To 10
      For S=1 To 20
         If A(T,S)=1
            Inc MOV
            If A(T+1,S)>1
               LIBERO=1
            End If
            If MOV=4
               Goto B
            End If
         End If
      Next
   Next
   B:
   If LIBERO=1 Then Pop Proc
   MOV=0
   For T=10 To 1 Step -1
      For S=1 To 20
         If A(T,S)=1
            A(T,S)=0
            A(T+1,S)=1
            Inc MOV
            If MOV=4
               Goto A
            End If
         End If
      Next
   Next
   A:
   Bob 2,X Bob(2)+10,,
End Proc
Procedure _GIU
   _TOCCATO=0
   LIBERO=0
   MOV=0
   For S=1 To 20
      For T=1 To 10
         If A(T,S)=1
            Inc MOV
            If A(T,S+1)>1
               LIBERO=1
            End If
            If MOV=4
               Goto A
            End If
         End If
      Next
   Next
   A:
   If LIBERO=1 Then _TOCCATO=1 : Pop Proc
   MOV=0
   For S=20 To 1 Step -1
      For T=1 To 10
         If A(T,S)=1
            A(T,S)=0
            A(T,S+1)=1
            Inc MOV
            If MOV=4
               Goto A1
            End If
         End If
      Next
   Next
   A1:
   Bob 2,,Y Bob(2)+10,
End Proc
Procedure _GIRA
   Inc RUOTATE
   E=I Bob(2)
   If Y Bob(2)=24 Then Pop Proc
   Gosub PR
   If E=1
      Inc Y
      If X>8 or X<2
         Pop Proc
      End If
      If A(X-1,Y)=0 and A(X+1,Y)=0 and A(X+2,Y)=0
         A(X-1,Y)=1 : A(X+1,Y)=1 : A(X+2,Y)=1
         A(X,Y-1)=0 : A(X,Y+1)=0 : A(X,Y+2)=0
         Bob 2,X Bob(2)-10,Y Bob(2)+10,2
         Pop Proc
      End If
   End If
   If E=2
      Inc X
      If Y>18
         Pop Proc
      End If
      If A(X,Y-1)=0 and A(X,Y+1)=0 and A(X,Y+2)=0
         A(X,Y-1)=1 : A(X,Y+1)=1 : A(X,Y+2)=1
         A(X-1,Y)=0 : A(X+1,Y)=0 : A(X+2,Y)=0
         Bob 2,X Bob(2)+10,Y Bob(2)-10,1
      End If
   End If
   If E=3 or E=4
      Pop Proc
   End If
   If E=5
      If Y>18
         Pop Proc
      End If
      If A(X,Y+1)=0 and A(X,Y+2)=0
         A(X,Y)=0 : A(X+2,Y+1)=0
         A(X,Y+1)=1 : A(X,Y+2)=1
         Bob 2,,,6
         Pop Proc
      End If
   End If
   If E=6
      If X>19
         Pop Proc
      End If
      If A(X-1,Y)=0 and A(X+1,Y+1)=0
         A(X-1,Y)=1 : A(X+1,Y+1)=1
         A(X-1,Y+1)=0 : A(X-1,Y+2)=0
         Bob 2,,,5
      End If
   End If
   If E=7
      If Y>18
         Pop Proc
      End If
      If A(X,Y+2)=0 and A(X-1,Y)=0
         A(X,Y+2)=1 : A(X-1,Y)=1
         A(X,Y)=0 : A(X+1,Y)=0
         Bob 2,,,8
         Pop Proc
      End If
   End If
   If E=8
      If X>18
         Pop Proc
      End If
      If A(X+1,Y)=0 and A(X+2,Y)=0
         A(X+1,Y)=1 : A(X+2,Y)=1
         A(X,Y)=0 : A(X+1,Y+2)=0
         Bob 2,,,7
      End If
   End If
   If E=9
      If A(X-1,Y)=0 and A(X,Y+2)=0
         A(X-1,Y)=1 : A(X,Y+2)=1
         A(X-2,Y+1)=0 : A(X-1,Y+1)=0
         Bob 2,X Bob(2)+10,,10
         Pop Proc
      End If
   End If
   If E=10
      If X>8
         Pop Proc
      End If
      If A(X+2,Y)=0 and A(X,Y+1)=0
         A(X+2,Y)=1 : A(X,Y+1)=1
         A(X+1,Y+1)=0 : A(X+1,Y+2)=0
         Bob 2,,,11
         Pop Proc
      End If
   End If
   If E=11
      If A(X,Y+2)=0 and A(X+1,Y+2)=0
         A(X,Y+2)=1 : A(X+1,Y+2)=1
         A(X+1,Y)=0 : A(X+2,Y)=0
         Bob 2,,,12
         Pop Proc
      End If
   End If
   If E=12
      If X>8
         Pop Proc
      End If
      If A(X+1,Y)=0 and A(X+1,Y+1)=0 and A(X-1,Y+1)=0
         A(X+1,Y)=1 : A(X+1,Y+1)=1 : A(X-1,Y+1)=1
         A(X,Y)=0 : A(X,Y+2)=0 : A(X+1,Y+2)=0
         Bob 2,X Bob(2)-10,,9
      End If
   End If
   If E=13
      If X<3
         Pop Proc
      End If
      If A(X-2,Y+1)=0 and A(X-1,Y+1)=0
         A(X-2,Y+1)=1 : A(X-1,Y+1)=1
         A(X,Y)=0 : A(X-1,Y+2)=0
         Bob 2,X Bob(2)-10,Y Bob(2)+10,14
         Pop Proc
      End If
   End If
   If E=14
      If A(X+1,Y-1)=0 and A(X+2,Y-1)=0 and A(X+1,Y+1)=0
         A(X+1,Y-1)=1 : A(X+2,Y-1)=1 : A(X+1,Y+1)=1
         A(X,Y)=0 : A(X+2,Y)=0 : A(X+2,Y+1)=0
         Bob 2,X Bob(2)+10,Y Bob(2)-10,15
         Pop Proc
      End If
   End If
   If E=15
      If X>8
         Pop Proc
      End If
      If A(X+1,Y+1)=0 and A(X+2,Y+1)=0
         A(X+1,Y+1)=1 : A(X+2,Y+1)=1
         A(X+1,Y)=0 : A(X,Y+2)=0
         Bob 2,,,16
         Pop Proc
      End If
   End If
   If E=16
      If A(X+1,Y)=0 and A(X+1,Y+2)=0 and A(X,Y+2)=0
         A(X+1,Y)=1 : A(X+1,Y+2)=1 : A(X,Y+2)=1
         A(X,Y)=0 : A(X,Y+1)=0 : A(X+2,Y+1)=0
         Bob 2,,,13
         Pop Proc
      End If
   End If
   If E=17
      A(X+1,Y-1)=1 : A(X,Y)=0
      Bob 2,X Bob(2)+10,Y Bob(2)-10,18
      Pop Proc
   End If
   If E=18
      If A(X-1,Y+1)=0
         A(X-1,Y+1)=1 : A(X,Y+2)=0
         Bob 2,X Bob(2)-10,,19
         Pop Proc
      End If
   End If
   If E=19
      If A(X,Y+2)=0
         A(X,Y+2)=1 : A(X+1,Y+1)=0
         Bob 2,,,20
         Pop Proc
      End If
   End If
   If E=20
      If A(X+1,Y+1)=0
         A(X+1,Y+1)=1 : A(X,Y)=0
         Bob 2,,Y Bob(2)+10,17
         Pop Proc
      End If
   End If
   Pop Proc
   PR:
   For S=1 To 20
      For T=1 To 10
         If A(T,S)=1
            X=T : Y=S : Return
         End If
      Next
   Next
   Return
End Proc
Procedure CANCELLA
   CONT=0
   For T=1 To 20
      MOV=0
      For S=1 To 10
         If A(S,T)<>0
            Inc MOV
         End If
      Next
      If MOV=10
         Inc CONT
         For Q=T To 1 Step -1
            For W=1 To 10
               A(W,Q)=A(W,Q-1)
            Next
         Next
         _TOGLI[T]
      End If
   Next
   If CONT=1
      PU=10
   End If
   If CONT=2
      PU=25
   End If
   If CONT=3
      PU=45
   End If
   If CONT=4
      PU=80
      Sam Play 12 : Wait 25
   End If
   Add PUNTI,PU
   PUNTI[1,1]
   If CONT=0 Then Wait 8
End Proc
Procedure _TOGLI[LI]
   Sam Play 7
   W=(LI-1)*10+25
   Pack S To 10,30,25,138,W
   Ink 9
   For T=0 To 4
      Wait Vbl
      Draw 30,W+T To 129,W+T
      Draw 30,W+9-T To 129,W+9-T
   Next
   Ink 0
   Bar 30,25 To 129,39
   Unpack 10,30,35
   Inc LINEE
End Proc
Procedure PAUSE
   DELI=Timer
   Unpack 15 To 1
   Repeat
   Until Key Shift=0
   Screen Close 1
   Timer=DELI
End Proc
Procedure SEB[SCR,C,N,D]
   'A Screen Eater by Paul Hickman ([e-mail])
   'N = No. Strips & must be a factor of screen height
   'D = Delay : 0 = Fastest Speed : >0 = Slower
   Screen SCR
   Ink C : W=Screen Height/N
   For A=0 To N-1
      Draw 0,A*W To Screen Width,A*W
   Next
   Draw 0,Screen Height-1 To Screen Width,Screen Height-1
   Screen Swap
   For A=0 To W/2
      Screen Copy Physic To Logic
      For B=0 To N-1
         Screen Copy Physic,0,B*W+A,Screen Width,B*W+W/2-1 To Logic,0,B*W+A+1
         Screen Copy Physic,0,B*W+W/2+1,Screen Width,(B+1)*W-A+1 To Logic,0,B*W+W/2
      Next
      Screen Swap
      If D>0 Then Wait D
      Wait Vbl
   Next
End Proc
'
Procedure PRESENTAZIONE
   ARCOBALENO[160]
   Unpack 9 To 0
   Ink 27
   Text 10,10,"F1- Start    F2- Options    F3- Info"
   Do
      If Key State(69) Then End
      If Key State(80) Then Pop Proc
      If Key State(81) Then OPTIONS
      If Key State(82) Then INFO
   Loop
End Proc
Procedure OPTIONS
   Unpack 12 To 0
   Show On
   Limit Mouse 129,55 To 424,292
   X Mouse=250
   Y Mouse=150
   Every 3 Proc JO
   A$=""
   For T=0 To 9
      A$=A$+"(9"+Str$(T)+"0,2)"
   Next
   For T=9 To 0
      A$=A$+"(9"+Str$(T)+"0,2)"
   Next
   Flash 5,A$
   Reserve Zone 11
   Set Zone 1,161,94 To 195,116
   Set Zone 2,161,118 To 195,140
   Set Zone 3,65,166 To 112,190
   For T=1 To 8
      Set Zone T+3,257,((T-1)*19)+81 To 270,((T-1)*19)+95
   Next
   Show On
   Bob 3,254,(HIGH*19)+79,23
   If _MUSICA=1
      Bob 1,161,94,21
   Else
      Bob 1,161,94,22
   End If
   If ARCOBALENO=1
      Bob 2,161,118,21
   Else
      Bob 2,161,118,22
   End If
   Do
      If Mouse Click or Fire(1) or Key Shift=2
         DELIU=Mouse Zone
         If DELIU>3
            HIGH=DELIU-4
            Bob 3,,(HIGH*19)+79,
         End If
         If DELIU=1
            If _MUSICA=1
               _MUSICA=0
               Bob 1,,,22
            Else
               _MUSICA=1
               Bob 1,,,21
            End If
         End If
         If DELIU=2
            If ARCOBALENO=1
               ARCOBALENO=0
               Bob 2,,,22
            Else
               ARCOBALENO=1
               Bob 2,,,21
            End If
         End If
         If DELIU=3
            Hide On
            Reset Zone
            Flash Off
            Unpack 9 To 0
            Ink 27
            Text 10,10,"F1- Start    F2- Options    F3- Info"
            Every Off
            Pop Proc
         End If
         Repeat
         Until Fire(1)=False and Key Shift=0
      End If
   Loop
End Proc
Procedure INFO
   PAS=6
   Ink 27,0
   For T=40 To 211 Step 9
      Read LINE$
      K=8
      U=0
      For S=1 To Len(LINE$)
         If Mouse Click Then PAS=1
         Inc U
         If Mid$(LINE$,U,1)<>" "
            Shoot
            Text K,T,Mid$(LINE$,U,1)
            If PAS=6
               Wait PAS
            End If
         Else
            If PAS=6
               Wait 2
            End If
         End If
         Add K,7
      Next
      Bell 70
      If PAS=6 Then Wait 20
   Next
   Do
      Exit If Mouse Click
   Loop
   Unpack 9 To 0
   Ink 27
   Text 10,10,"F1- Start    F2- Options    F3- Info"
   Data "Welcome in this new TETRIS!!"
   Data "To play it use the arrows:"
   Data "<- to move left   to move right ->"
   Data "^ to rotate       to move down |"
   Data "                -----"
   Data "Beware: If you move down, you can't"
   Data "    change its position, but you make"
   Data "    much more points."
   Data "The level change every 15 lines!"
   Data "Caps Lock to PAUSE."
   Data "Press ESC to quit."
   Data "                -----"
   Data "Entirely programmed in AMOS The Creator"
   Data "                -----"
   Data "To have the sources code write to:"
   Data " By MICHELE BERIONNE"
   Data "    Via RUBICONE 42"
   Data "    00198 ROME ITALY"
   Data "    "
   Data "Thank you! And enjoy yourself!"
End Proc
Procedure JO
   If Key State(76) Then B=-1
   If Key State(77) Then B=1
   If Key State(79) Then A=-1
   If Key State(78) Then A=1
   If A=1 Then X Mouse=X Mouse+5
   If A=-1 Then X Mouse=X Mouse-5
   If B=1 Then Y Mouse=Y Mouse+5
   If B=-1 Then Y Mouse=Y Mouse-5
   Every On
End Proc
Procedure ALTEZZA
   STEF=HIGH*2
   For K=20 To 20-STEF Step -1
      For L=1 To 10
         FR=Rnd(12)
         If FR>4
            A(L,K)=2
         End If
      Next
   Next
   For K=20 To 20-STEF Step -1
      W=0
      For L=1 To 10
         Add W,A(L,K)
      Next
      If W=20
         AZE=Rnd(9)+1
         A(AZE,K)=0
      End If
   Next
   For K=20 To 20-STEF Step -1
      For L=1 To 10
         If A(L,K)=2
            Paste Bob((L-1)*10)+29,((K-1)*10)+24,Rnd(6)+25
         End If
      Next
   Next
End Proc
Procedure RIEMPI
   For K=20 To 1 Step -1
      For L=1 To 10
         If A(L,K)=0
            Paste Bob((L-1)*10)+29,((K-1)*10)+24,Rnd(6)+25
         End If
      Next
      Wait 3
   Next
End Proc
Procedure ARCOBALENO[W]
   Set Rainbow 0,0,30,"","(1,1,15)(1,-1,15)",""
   Rainbow 0,0,49,32
   Set Rainbow 1,0,30,"","","(1,1,15)(1,-1,15)"
   Rainbow 1,0,49,32
   Set Rainbow 2,0,30,"(1,1,15)(1,-1,15)","",""
   Rainbow 2,0,49,32
   Set Rainbow 3,0,30,"(1,1,15)(1,-1,15)","","(1,1,15)(1,-1,15)"
   Rainbow 3,0,49,32
   Channel 0 To Rainbow 0
   Channel 1 To Rainbow 1
   Channel 2 To Rainbow 2
   Channel 3 To Rainbow 3
   E$=Str$(W)
   Amal 0,"Loop: Move 0,"+E$+",100 ; Move 0,-"+E$+",100 ; JL"
   Amal 1,"For R1=1 To 25 ; Next R1 ; Loop: Move 0,"+E$+",100 ; Move 0,-"+E$+",100 ; JL "
   Amal 2,"For R2=1 To 50 ; Next R2 ; Loop: Move 0,"+E$+",100 ; Move 0,-"+E$+",100 ; JL"
   Amal 3,"For R3=1 To 75 ; Next R3 ; Loop: Move 0,"+E$+",100 ; Move 0,-"+E$+",100 ; JL"
   Amal On
End Proc
Procedure STATISTICA[REP]
   Inc STATISTICA(REP)
   If STATISTICA(REP)>92 Then Pop Proc
   X=((REP-1)*4)+259
   Y=224-((STATISTICA(REP)-1)*2)
   Box X,Y To X+1,Y-1
End Proc
'
'
'
FINE:
Sam Play 4
Boom
Music Off
Shift Off
Amal Off
RIEMPI
Rainbow Del
Fade 15
Wait 50
Open Random 1,"topotto"
Field 1,3 As NOME$,5 As SCO$
For T=1 To 8
   Get 1,T
   NOME$(T)=NOME$ : SCORE(T)=Val(SCO$)
Next
Close 1
PIT=PUNTI
Unpack 16 To 0
Ink 5,7
Text 50,230,"You scored:"+Str$(PIT)
Ink 9,14
If PIT<SCORE(8)
   For T=1 To 8
      Text 100,110+((T-1)*10),NOME$(T)
      Text 140,110+((T-1)*10),Str$(SCORE(T))
   Next
   Repeat
   Until Fire(1) or Mouse Click
   Goto INIZIO
End If
For T=8 To 1 Step -1
   If PIT>SCORE(T) Then POS=T
Next
For T=8 To POS Step -1
   SCORE(T+1)=SCORE(T)
   NOME$(T+1)=NOME$(T)
Next
SCORE(POS)=PIT
NOME$(POS)=""
Clear Key
For T=1 To 8
   Text 100,110+((T-1)*10),NOME$(T)
   Text 140,110+((T-1)*10),Str$(SCORE(T))
Next
NO$=""
Clear Key
Ink 14,7
Text 100,110+(POS-1)*10,"   "
Ink 9,14
Repeat
   A$=Inkey$
   If A$<>""
      NO$=NO$+A$
      Text 100,110+((POS-1)*10),NO$
   End If
Until Len(NO$)=3
NOME$(POS)=NO$
Open Random 1,"topotto"
Field 1,3 As NOME$,5 As SCO$
For T=1 To 8
   NOME$=NOME$(T) : SCO$=Str$(SCORE(T))
   Put 1,T
Next
Close 1
Repeat
Until Fire(1) or Mouse Click
Goto INIZIO